home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / TURB_VIS / PGC122 / BBERROR.PAS < prev    next >
Pascal/Delphi Source File  |  1994-02-09  |  4KB  |  39 lines
  1. (* This file was mangled by Mangler 1.14 (c) Copyright 1993 by Berend de Boer *)
  2.  {$IFDEF DPMI} {$S-,Q-,R-,I-,V-} {$ELSE} {$O+,F+,R-,Q-,S-,V-,I-} {$ENDIF} UNIT BBERROR ;INTERFACE USES DOS ;
  3. CONST FATALERRORTEXT :STRING [ 128 ] ='Fatal error. Errorcode: ';TYPE HANDLERUNTIMEERRORPROCEDURETYPE =PROCEDURE 
  4. (STACKFRAME :WORD );DUMPSTACKPROCEDURETYPE =PROCEDURE  (ADDR :POINTER ;STACKFRAME :WORD );VAR FERR :TEXT ;
  5. HANDLERUNTIMEERROR :HANDLERUNTIMEERRORPROCEDURETYPE ;DUMPSTACK :DUMPSTACKPROCEDURETYPE ;FUNCTION GETLOGICALADDR
  6. (ADDR :POINTER ):POINTER ;PROCEDURE LOGERROR (CONST S :STRING );PROCEDURE INSTALLEXITHANDLER (CONST AFILENAME :PATHSTR );
  7. IMPLEMENTATION USES OBJECTS , MEMORY , {$IFDEF DPMI} WINAPI , {$ENDIF} BBUTIL , BBFILE , BBGUI ;FUNCTION GETLOGICALADDR
  8. (ADDR:POINTER):POINTER ;ASSEMBLER;ASM {} {$IFDEF DPMI} {} MOV DX , WORD PTR ADDR+ 2 {} CMP DX , 0 {} JE @@end {}
  9. VERR DX {} JE @@selok {} XOR DX , DX {} JMP @@end {} @@selok : {} MOV ES , DX {} MOV DX , WORD PTR ES : [ 0 ] {}
  10. @@end : {} MOV AX , WORD PTR ADDR{} {$ENDIF} {} {$IFDEF MSDOS} {} MOV CX , WORD PTR ADDR{} MOV BX , WORD PTR ADDR+ 2 {}
  11. MOV AX , OVRLOADLIST{} @@0 : {} OR AX , AX {} JE @@3 {} MOV ES , AX {} MOV AX , ES : WORD PTR 16 {} OR AX , AX {}
  12. JE @@1 {} SUB AX , BX {} JA @@1 {} NEG AX {} CMP AX , 1000h {} JAE @@1 {} MOV DX , 16 {} MUL DX {} ADD AX , CX {}
  13. JC @@1 {} CMP AX , ES : WORD PTR 8 {} JB @@2 {} @@1 : {} MOV AX , ES : WORD PTR 20 {} JMP @@0 {} @@2 : {} MOV CX , AX {}
  14. MOV BX , ES {} @@3 : {} SUB BX , PREFIXSEG{} SUB BX , 10h {} MOV AX , CX {} MOV DX , BX {} {$ENDIF} {} END;
  15. PROCEDURE O100I0IOIOl (OOlIl0OOIIOO:POINTER;O100llIl00IOl:WORD);FAR ;PROCEDURE O1011O1IO1O10 (OOlIl0OOIIOO:POINTER);
  16. BEGIN WITH PTRREC(OOlIl0OOIIOO) DO WRITELN (FERR , '  ', HEXSTR (SEG ), ':', HEXSTR (OFS ));END ;VAR O101O01III1II:WORD;
  17. O100Ol00I:POINTER;BEGIN IF NOT FILEOPEN (FERR )THEN EXIT ;LOGERROR ('**Stack dump. Callers shown only**');O100llIl00IOl
  18. := MEMW [ SSEG :O100llIl00IOl ] ;O101O01III1II := MEMW [ SSEG :O100llIl00IOl ] ;IF O101O01III1II MOD 2 =1 THEN DEC
  19. (O101O01III1II );O100Ol00I := OOlIl0OOIIOO ;WHILE (O101O01III1II > O100llIl00IOl )AND (MEMW [ SSEG :O100llIl00IOl ] <> 0
  20. ) DO BEGIN PTRREC (OOlIl0OOIIOO ). OFS := MEMW [ SSEG :O100llIl00IOl + 2 ] ;IF MEMW [ SSEG :O100llIl00IOl + 4 ]
  21. =O101O01III1II THEN PTRREC (OOlIl0OOIIOO ). SEG := PTRREC (O100Ol00I ). SEG ELSE BEGIN PTRREC (OOlIl0OOIIOO ). SEG :=
  22. MEMW [ SSEG :O100llIl00IOl + 4 ] ;OOlIl0OOIIOO := GETLOGICALADDR (OOlIl0OOIIOO );IF PTRREC (OOlIl0OOIIOO ). SEG =0 THEN
  23. PTRREC (OOlIl0OOIIOO ). SEG := PTRREC (O100Ol00I ). SEG ;END ;O100llIl00IOl := O101O01III1II ;O1011O1IO1O10 (OOlIl0OOIIOO
  24. );O101O01III1II := MEMW [ SSEG :O100llIl00IOl ] ;IF O101O01III1II MOD 2 =1 THEN DEC (O101O01III1II );O100Ol00I :=
  25. OOlIl0OOIIOO ;END ;END ;PROCEDURE LOGERROR (CONST S:STRING );BEGIN IF FILEOPEN (FERR )THEN WRITELN (FERR , GETDATESTR ,
  26. ' ', GETTIMESTR , '  ', S );END ;PROCEDURE O10O0I0llIOl0 (O100llIl00IOl:WORD);FAR ;BEGIN WRITE (FERR , GETDATESTR , '  ',
  27. GETTIMESTR , '  ');WRITE (FERR , 'Errorcode = ', EXITCODE , '  ');WRITELN (FERR , 'Erroraddr = ', HEXSTR (PTRREC
  28. (ERRORADDR ). SEG ), ':', HEXSTR (PTRREC (ERRORADDR ). OFS ));WRITELN (FERR , 'MaxAvail = ', MAXAVAIL );WRITELN (FERR ,
  29. 'MemAvail = ', MEMAVAIL );DUMPSTACK (ERRORADDR , O100llIl00IOl );CLOSE (FERR );APPEND (FERR );INFOBOX (FATALERRORTEXT +
  30. STRW (EXITCODE ), 0 );END ;VAR O1lO11Il00lI:POINTER;PROCEDURE OIO0OO1100O ;FAR ;VAR OIOO:WORD;OIO1OO11I1:WORD;
  31. BEGIN ASM {} MOV OIO1OO11I1, BP {} END;EXITPROC := O1lO11Il00lI ;OIOO := IORESULT ;IF (EXITCODE =0 )OR (ERRORADDR =NIL
  32. )THEN BEGIN WRITELN (FERR , 'Program ended on ', GETDATESTR , ' at ', GETTIMESTR );CLOSE (FERR );EXIT ;END ;
  33. HANDLERUNTIMEERROR (OIO1OO11I1 );CLOSE (FERR );END ;{$IFDEF DPMI} FUNCTION O1011I1OlOIO1 (OI1OIIIl0lO1:WORD):INTEGER ;
  34. FAR ;BEGIN O1011I1OlOIO1 := 1 ;END ;{$ENDIF} PROCEDURE INSTALLEXITHANDLER (CONST AFILENAME:PATHSTR);BEGIN O1lO11Il00lI :=
  35. EXITPROC ;EXITPROC := @ OIO0OO1100O ;DUMPSTACK := O100I0IOIOl ;HANDLERUNTIMEERROR := O10O0I0llIOl0 ;ASSIGN (FERR ,
  36. AFILENAME );IF NOT FILEEXIST (AFILENAME )THEN REWRITE (FERR )ELSE APPEND (FERR );WRITELN (FERR );WRITELN (FERR ,
  37. '** Program started on ', GETDATESTR , ' at ', GETTIMESTR , ' **');{$IFDEF DPMI} HEAPERROR := @ O1011I1OlOIO1 ;{$ENDIF}
  38. END ;END .
  39.